home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / CRYSTAL / RCMGR.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-08-01  |  2.4 KB  |  138 lines
  1. IMPLEMENTATION MODULE RcMgr;
  2.  
  3. (*
  4. Rectangle Manager.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM PORTAB IMPORT SIGNEDWORD,UNSIGNEDWORD;
  12. #if long
  13. FROM INTRINSIC IMPORT LONG;
  14. #endif
  15. CAST_IMPORT
  16.  
  17. PROCEDURE Min(a,b: SIGNEDWORD): SIGNEDWORD;
  18. BEGIN
  19. #if long
  20.  
  21. #else
  22.   IF a > b THEN
  23.     RETURN b;
  24.   ELSE
  25.     RETURN a;
  26.   END;
  27. #endif
  28. END Min;
  29.  
  30. PROCEDURE Max(a,b: SIGNEDWORD): SIGNEDWORD;
  31. BEGIN
  32. #if long
  33.  
  34. #else
  35.   IF a < b THEN
  36.     RETURN b;
  37.   ELSE
  38.     RETURN a;
  39.   END;
  40. #endif
  41. END Max;
  42.  
  43. PROCEDURE RcIntersect(VAR R1,R2: GRect): BOOLEAN;
  44.  
  45. VAR T: GRect;
  46.  
  47. BEGIN
  48.   WITH T DO
  49.     GW:= Min(R2.GX + R2.GW,R1.GX + R1.GW);
  50.     GH:= Min(R2.GY + R2.GH,R1.GY + R1.GH);
  51.     GX:= Max(R2.GX,R1.GX);
  52.     GY:= Max(R2.GY,R1.GY);
  53.     R2.GX:= GX;
  54.     R2.GY:= GY;
  55.     R2.GW:= GW - GX;
  56.     R2.GH:= GH - GY;
  57.     RETURN (GW > GX) AND (GH > GY);
  58.   END;
  59. END RcIntersect;
  60.  
  61. PROCEDURE RcUnion(VAR R1,R2: GRect);
  62.  
  63. VAR T: GRect;
  64.  
  65. BEGIN
  66.   WITH T DO
  67.     GW:= Max(R2.GX + R2.GW,R1.GX + R1.GW);
  68.     GH:= Max(R2.GY + R2.GH,R1.GY + R1.GH);
  69.     GX:= Min(R2.GX,R1.GX);
  70.     GY:= Min(R2.GY,R1.GY);
  71.     R2.GX:= GX;
  72.     R2.GY:= GY;
  73.     R2.GW:= GW - GX;
  74.     R2.GH:= GH - GY;
  75.   END;
  76. END RcUnion;
  77.  
  78. PROCEDURE RcConstrain(R1: GRect; VAR R2: GRect);
  79. BEGIN
  80.   IF R2.GX < R1.GX THEN
  81.     R2.GX:= R1.GX;
  82.   END;
  83.  
  84.   IF R2.GY < R1.GY THEN
  85.     R2.GY:= R1.GY;
  86.   END;
  87.  
  88.   IF (R2.GX + R2.GW) > (R1.GX + R1.GW) THEN
  89.     R2.GX:= R1.GX + R1.GW - R2.GW;
  90.   END;
  91.  
  92.   IF (R2.GY + R2.GH) > (R1.GY + R1.GH) THEN
  93.     R2.GY:= R1.GY + R1.GH - R2.GH;
  94.   END;
  95. END RcConstrain;
  96.  
  97. PROCEDURE RcEqual(VAR R1,R2: GRect): BOOLEAN;
  98. BEGIN
  99.   RETURN (R1.GX = R2.GX) AND
  100.          (R1.GY = R2.GY) AND
  101.          (R1.GW = R2.GW) AND
  102.          (R1.GH = R2.GH);
  103. END RcEqual;
  104.  
  105. PROCEDURE RcCopy(VAR From,To: GRect);
  106. BEGIN
  107.   To:= From;
  108. END RcCopy;
  109.  
  110. PROCEDURE RcInside(P: GPnt; VAR R: GRect): BOOLEAN;
  111. BEGIN
  112.   WITH R DO
  113.     RETURN (P.GX >= GX) AND
  114.            (P.GY >= GY) AND
  115.            (P.GX < (GX + GW)) AND
  116.            (P.GY < (GY + GH));
  117.   END;
  118. END RcInside;
  119.  
  120. PROCEDURE RcSnap(X: SIGNEDWORD; N: UNSIGNEDWORD): SIGNEDWORD;
  121. BEGIN
  122.   X:= X + CAST(SIGNEDWORD,N) DIV 4 - 1;
  123.   RETURN CAST(SIGNEDWORD,N) * (X DIV CAST(SIGNEDWORD,N));
  124. END RcSnap;
  125.  
  126. PROCEDURE XYWHToGRect(    X,Y,W,H: SIGNEDWORD;
  127.                       VAR Rect   : GRect);
  128. BEGIN
  129.   WITH Rect DO
  130.     GX:= X;
  131.     GY:= Y;
  132.     GW:= W;
  133.     GH:= H;
  134.   END;
  135. END XYWHToGRect;
  136.  
  137. END RcMgr.
  138.